home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Modes / htmlExtra.tcl < prev    next >
Text File  |  1996-08-15  |  16KB  |  612 lines
  1. #===============================================================================
  2. #
  3. #     htmlExtra.tcl
  4. #
  5. #    Part of HTML mode 1.2
  6. #
  7. #     Routines for giving attributes in the status bar.
  8. #
  9. #     Author: Johan Linde <jl@theophys.kth.se>
  10. #
  11. #    If you make improvements to this file, please share them!
  12. #
  13. #===============================================================================
  14.  
  15. # Opening or only tag of an element - include attributes
  16. # Status bar or popup for each attribute.
  17. # Return empty string if user skips an attribute which must be used.
  18. proc htmlOpenElemLoop {elem used} {
  19.     global htmlActiveElem htmlActiveUsed htmlActiveAttr htmlActiveCache
  20.     global HTMLmodeVars htmlPackageToUse htmlElemEventHandler1
  21.     global htmlURLAttr htmlColorAttr htmlWindowAttr
  22.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  23.     
  24.     set promptNoisily $HTMLmodeVars(promptNoisily)
  25.     
  26.     if {![string length $used]} {set used $elem}
  27.     set elem [string toupper $elem]
  28.     set used [string toupper $used]
  29.     
  30.     set htmlActiveUsed $used
  31.     set htmlActiveElem $elem
  32.     set text "<"
  33.     append text [htmlSetCase $elem]
  34.  
  35.     # if there are attributes to ask about, do so
  36.     set reqatts [htmlGetRequired $used]
  37.     set useatts [htmlGetUsed $used]
  38.     set askformore [htmlGetAttrMore $used]
  39.     set optatts [htmlGetOptional $used]
  40.     set NumberAttrs [htmlGetNumber $used]
  41.     # Add missing required attributes.
  42.     foreach a $reqatts {
  43.         if {[lsearch -exact $useatts $a] < 0} {
  44.             set useatts "$a $useatts"
  45.         }
  46.     }
  47.     # Remove extra attributes
  48.     foreach a $useatts {
  49.         if {[lsearch -exact $reqatts $a] < 0 && [lsearch -exact $optatts $a] < 0} {
  50.             set where [lsearch -exact $useatts $a]
  51.             set useatts [lreplace $useatts $where $where]
  52.         }
  53.     }
  54.     
  55.     set allatts $useatts
  56.     set eventatts ""
  57.     # If the ask for more flag is set, add the rest of the attributes.
  58.     if {$askformore} {
  59.         foreach attr $optatts {
  60.             if {[lsearch -exact $useatts $attr] < 0} { lappend allatts $attr}
  61.         }
  62.         # optionally include event handlers
  63.         if {$HTMLmodeVars(inclEventHandler) && $htmlPackageToUse == 1 && ¥
  64.         [info exists htmlElemEventHandler1($used)]} {
  65.             set eventatts $htmlElemEventHandler1($used)
  66.             append allatts " " $eventatts
  67.         }
  68.     }
  69.     
  70.     for {set i 0} {$i < [llength $allatts]} {incr i} {
  71.         set attr [lindex $allatts $i]
  72.         if {$i == [llength $useatts]} { 
  73.             # it's time to ask if more is wanted
  74.             if {$promptNoisily} {beep}
  75.             set more ""
  76.             if {$used == "LI IN UL" || $used == "LI IN OL"} {
  77.                 set pr "LI:"
  78.             } else {
  79.                 set pr "${used}:"
  80.             }
  81.             while {[catch {statusPrompt "$pr More attributes? ¥[n¥] " htmlStatusAskYesOrNo} more]} {
  82.                 if {$more == "Cancel all!"} {
  83.                     message "Cancel"
  84.                     error
  85.                 }
  86.             }
  87.             if {$more != "yes"} { break }
  88.         }
  89.         if {[lsearch -exact $reqatts $attr] >= 0} {
  90.             set required 1
  91.         } else {
  92.             set required 0
  93.         }
  94.         set htmlActiveAttr $attr
  95.         set a2 [string trimright $attr =]
  96.         if {[string index $attr [expr [string length $attr] - 1]] == "="} {
  97.             if {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${used}!=$a2"] < 0) || ¥
  98.             [lsearch -exact $htmlSpecURL "${used}=$a2"] >= 0} { 
  99.                 # URL attibute
  100.                 set htmlActiveCache URLs
  101.                 set v [htmlAskURL $attr $required]
  102.                 if {[string length $v]} {
  103.                     append text " " [htmlSetCase $attr] [htmlAddQuotes $v]
  104.                 }
  105.             } elseif {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${used}!=$a2"] < 0) || ¥
  106.             [lsearch -exact $htmlSpecColor "${used}=$a2"] >= 0} { 
  107.                 # Color attribute
  108.                 set v [htmlAskColor $attr $required]
  109.                 if {[string length $v]} {
  110.                     append text " " [htmlSetCase $attr] [htmlAddQuotes $v]
  111.                 }
  112.             } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${used}!=$a2"] < 0) || ¥
  113.             [lsearch -exact $htmlSpecWindow "${used}=$a2"] >= 0} { 
  114.                 # Window attribute
  115.                 set htmlActiveCache windows
  116.                 set v [htmlAskURL $attr $required]
  117.                 if {[string length $v]} {
  118.                     append text " " [htmlSetCase $attr] [htmlAddQuotes $v]
  119.                 }
  120.             } elseif {[lsearch $NumberAttrs "$attr*"] >= 0} { 
  121.                 # Number attribute
  122.                 set v [htmlAskNumber $used $attr $required]
  123.                 if {[string length $v]} {
  124.                     append text " " [htmlSetCase $attr] [htmlAddQuotes $v]
  125.                 }
  126.             } else { 
  127.                 # other attribute
  128.                 if {$promptNoisily} {beep}
  129.                 set v [htmlStatusAskAttr $used $attr $required]
  130.                 if {[string length $v]} {
  131.                     if {[lsearch -exact $eventatts $attr] < 0} {
  132.                         set attr [htmlSetCase $attr]
  133.                     }
  134.                     append text " " $attr [htmlAddQuotes $v]
  135.                 }
  136.             }
  137.             if {[string length $v]} {
  138.                 htmlOpenExtraThings $used $attr $v
  139.             }
  140.             if {![string length $v] && $required } {
  141.                 beep
  142.                 message "You must give $attr a value."
  143.                 set text ""
  144.                 break
  145.             } 
  146.         } else { 
  147.             # yes-no attribute
  148.             if {$promptNoisily} {beep}
  149.             set v ""
  150.             while {[catch {statusPrompt "${used}:$attr ¥[n¥] " htmlStatusAskYesOrNo} v]} {
  151.                 if {$v == "Cancel all!"} {
  152.                     message "Cancel"
  153.                     error
  154.                 }
  155.             }
  156.             if {$v == "yes"} {append text " " [htmlSetCase $attr]}
  157.         }
  158.     }
  159.  
  160.     # Some tests that input is ok.
  161.     if {[htmlFontBaseTest $text "message"]} {beep; set text ""}
  162.     if {$elem == "A" && [htmlATest $text "message"]} {beep; set text ""}
  163.     if {$elem == "FRAMESET" && [htmlFramesetTest $text "message"]} {beep; set text ""}
  164.     if {$elem == "SPACER" && [htmlSpacerTest $text "message"]} {beep; set text ""}
  165.     if {$elem == "AREA" && [htmlAreaTest $text "message"]} {beep; set text ""}
  166.     if {[string length $text] } {append text ">"}
  167.     catch {unset htmlActiveUsed}
  168.     catch {unset htmlActiveElem}
  169.     catch {unset htmlActiveAttr}
  170.     catch {unset htmlActiveCache}
  171.     return ${text}
  172. }
  173.  
  174. # Choose a color name or add a color number
  175.  
  176. proc htmlAskColor {attr required} {
  177.     global  HTMLmodeVars htmlColorTabSeen htmlActiveUsed htmlColorName
  178.     global  basicColors htmluserColors htmlColors htmlActiveColor
  179.     
  180.     set promptNoisily    $HTMLmodeVars(promptNoisily)
  181.     
  182. # put users colours first
  183.     set htmlColors [lsort [array names htmluserColors]]
  184.      append htmlColors " " $basicColors
  185.      
  186.      while {1} {
  187.          # Loop until input is valid or everything is cancelled, then something is returned
  188.          if {$promptNoisily} {beep}
  189.          set htmlColorTabSeen 0
  190.          set pr ""
  191.          if {!$required} { set pr "(optional) "}
  192.          append pr ${htmlActiveUsed}:${attr}
  193.          while {[catch {statusPrompt $pr htmlColorStatusFunc} r]} {
  194.              if {$r == "Cancel all!"} {
  195.                  message "Cancel"
  196.                  error
  197.              }
  198.              if {$r == "Continue!"} {
  199.                  set r $htmlActiveColor
  200.                  unset htmlActiveColor
  201.                  break
  202.              }
  203.          }
  204.          set r [string trim $r]
  205.          if {![string length $r]} {return}
  206.          # Users own color?
  207.          if {[info exists htmluserColors($r)]} {return $htmluserColors($r)}
  208.          # Predefined color?
  209.          if {[info exists htmlColorName($r)]} {
  210.              return $htmlColorName($r)
  211.          } else {
  212.              set col [htmlCheckColorNumber $r]
  213.              if {$col != 0} {
  214.                  return $col
  215.              } else {
  216.                  alertnote "$r is not a valid color number. It should be of the form #RRGGBB."
  217.              }
  218.          }
  219.      }
  220. }
  221.  
  222. proc htmlColorStatusFunc {curr c} {
  223.     global  htmlActiveAttr htmlColorTabSeen htmlColorName
  224.     global htmlColors htmlActiveColor htmlActiveUsed
  225.     
  226.     if {$c == "¥032"} {
  227.         error "Cancel all!"
  228.     }
  229.     # ctrl-f is new color.
  230.     if {$c == "¥006"} {
  231.         set newcolor [htmlAddNewColor]
  232.         if {[string length $newcolor]} {
  233.             set htmlActiveColor $newcolor
  234.             error "Continue!"
  235.         } else {
  236.             return
  237.         }
  238.     }
  239.     
  240.     if {$c != "¥t"} {
  241.         set htmlColorTabSeen 0
  242.         return $c
  243.     }
  244.  
  245.     set matches {}
  246.     set attr $htmlActiveAttr
  247.     foreach w $htmlColors {
  248.         if {[string match "$curr*" $w]} {
  249.             lappend matches $w
  250.         }
  251.     }
  252.     if {![llength $matches]} {
  253.         beep
  254.     } else {
  255.         if {$htmlColorTabSeen} {
  256.             if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
  257.                 set ret ""
  258.             }
  259.             if {[string length $ret]} {
  260.                 set htmlActiveColor $ret
  261.                 error "Continue!"
  262.             }
  263.             set htmlColorTabSeen 0
  264.         } else {
  265.             set htmlColorTabSeen 1
  266.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  267.         }
  268.         return $ret
  269.     }
  270.     return
  271. }
  272.  
  273.  
  274. # HREF attributes are handled as a listpick from a cached list
  275. proc htmlAskURL {attr required} {
  276.     global htmlURLTabSeen
  277.     global HTMLmodeVars htmlActiveUsed htmlActiveCache htmlActiveURL
  278.     
  279.     if {$HTMLmodeVars(promptNoisily)} {beep}
  280.     set htmlURLTabSeen 0
  281.     if {!$required} { set pr "(optional) "}
  282.     append pr ${htmlActiveUsed}:${attr}
  283.     while {[catch {statusPrompt $pr htmlURLStatusFunc} r]} {
  284.         if {$r == "Cancel all!"} {
  285.             message "Cancel"
  286.             error
  287.         }
  288.         if {$r == "Continue!"} {
  289.             set r $htmlActiveURL
  290.             unset htmlActiveURL
  291.             break
  292.         }
  293.     }
  294.     set r [string trim $r]
  295.     htmlAddToCache $htmlActiveCache $r
  296.     return $r
  297. }
  298.  
  299.  
  300. proc htmlURLStatusFunc {curr c} {
  301.     global HTMLmodeVars  htmlActiveAttr htmlURLTabSeen htmlActiveCache htmlActiveURL
  302.     global htmlActiveUsed
  303.     
  304.     if {$c == "¥032"} {
  305.         error "Cancel all!"
  306.     }
  307.     if {$htmlActiveCache == "windows"} {set URLs {_SELF _TOP _PARENT _BLANK}}
  308.     append URLs " " $HTMLmodeVars($htmlActiveCache)
  309.     
  310.     # ctrl-f for file dialog.
  311.     if {$c == "¥006"} {
  312.         if {$htmlActiveCache == "windows"} {
  313.             beep
  314.             return
  315.         }
  316.         set newURL [htmlGetFile]
  317.         if {[string length $newURL]} {
  318.             set htmlActiveURL $newURL
  319.             error "Continue!"
  320.         } else {
  321.             return
  322.         }
  323.     }
  324.  
  325.     if {$c != "¥t"} {
  326.         set htmlURLTabSeen 0
  327.         return $c
  328.     }
  329.  
  330.     set matches {}
  331.     set attr $htmlActiveAttr
  332.     foreach w $URLs {
  333.         if {[string match "$curr*" $w]} {
  334.             lappend matches $w
  335.         }
  336.     }
  337.     if {![llength $matches]} {
  338.         beep
  339.     } else {
  340.         if {$htmlURLTabSeen} {
  341.             if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
  342.                 set ret ""
  343.             }
  344.             if {[string length $ret]} {
  345.                 set htmlActiveURL $ret
  346.                 error "Continue!"
  347.             }
  348.             set htmlURLTabSeen 0
  349.         } else {
  350.             set htmlURLTabSeen 1
  351.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  352.         }
  353.         return $ret
  354.     }
  355.     return
  356. }
  357.  
  358. proc htmlStatusAskAttr {used attr required} {
  359.     global htmlAttrTabSeen htmlActiveInput
  360.  
  361.     set htmlAttrTabSeen 0
  362.     if {!$required} {
  363.         set pr "(optional) "
  364.     } else {
  365.         set pr {}
  366.     }
  367.     if {$used == "LI IN UL" || $used == "LI IN OL"} { # these two are special
  368.          append pr LI:$attr
  369.     } else {
  370.         append pr ${used}:$attr
  371.     }
  372.  
  373.     set v ""
  374.     while {[catch {statusPrompt $pr htmlAttrStatusFunc} v]} {
  375.         if {$v == "Cancel all!"} {
  376.             message "Cancel"
  377.             error
  378.         }
  379.         if {$v == "Continue!"} {
  380.             set v $htmlActiveInput
  381.             unset htmlActiveInput
  382.             break
  383.         }
  384.     }
  385.     
  386.     # Trim only if it's only spaces.
  387.     if {[string trim $v] == ""} {set v ""}
  388.      # if there are choices, check if the user has typed one.
  389.     set choices [htmlGetChoices $used]
  390.     
  391.     set matches {}
  392.     set areChoices [string match "*${attr}*" $choices]
  393.  
  394.     if {!$areChoices} {
  395.         return $v
  396.     } else {
  397.         foreach w $choices {
  398.             if {($used == "LI IN OL" || $used == "OL") && $attr == "TYPE="} { # special case
  399.                 set c ${attr}$v
  400.             } else {
  401.                 set c [string toupper "${attr}${v}*"]    
  402.             }
  403.             if {[string match "${c}*" $w]} {
  404.                 lappend matches  $w 
  405.             }
  406.         } 
  407.         # if unique extension, add what's needed, otherwise return nothing.
  408.         if {[llength $matches] == 1 && [string length $v]} {
  409.             set ret [string range $matches [string length $attr] end]
  410.             if {($used != "LI IN OL" && $used != "OL") || $attr != "TYPE="} {
  411.                 set ret [htmlSetCase $ret] 
  412.             }
  413.             return $ret
  414.         } else {
  415.             return
  416.         }
  417.     }
  418. }
  419.  
  420. # CDATA element attribute, status window match completion
  421. proc htmlAttrStatusFunc {curr c} {
  422.     global htmlActiveUsed htmlActiveAttr htmlAttrTabSeen htmlActiveInput
  423.  
  424.     if {$c == "¥032"} {error "Cancel all!"}
  425.     # should we set the case or not (are there predefined choices)?
  426.     set choices [htmlGetChoices $htmlActiveUsed]
  427.     set matches {}
  428.     set attr $htmlActiveAttr
  429.     set areChoices [string match "*${attr}*" $choices]
  430.     foreach w $choices {
  431.         if {($htmlActiveUsed == "LI IN OL" ||  $htmlActiveUsed == "OL") ¥
  432.             && $attr == "TYPE="} {     # special case
  433.             if {[string match "${attr}${curr}*" $w]} {
  434.                 lappend matches [string range $w [string length $attr] end]
  435.             }
  436.         } elseif {[string match [string toupper "${attr}${curr}*"] $w]} {
  437.             lappend matches [string range $w [string length $attr] end]
  438.         }
  439.     }
  440.     
  441.     if {$c != "¥t" } {
  442.         set htmlAttrTabSeen 0
  443.         if {$areChoices} {
  444.         # check if the last character matches
  445.             set matches {}
  446.             foreach w $choices {
  447.                 if {[string match [string toupper "${attr}${curr}${c}*"] $w]} {
  448.                     lappend matches [string range $w [string length $attr] end]
  449.                 }
  450.             }
  451.             if {[llength $matches]} { 
  452.                 if {($htmlActiveUsed != "LI IN OL" &&  $htmlActiveUsed != "OL") ¥
  453.                     || $attr != "TYPE="} { # special case 
  454.                     set c [htmlSetCase $c] 
  455.                 }
  456.                 return $c
  457.             } else {
  458.                 beep
  459.                 return
  460.             } 
  461.         } else {
  462.             return $c
  463.         }
  464.     }
  465.     
  466.     # it's a tab
  467.     if {![llength $matches]} {
  468.         beep
  469.     } else {
  470.         if {$htmlAttrTabSeen} {
  471.             if {[catch {listpick -p ${htmlActiveUsed}:${htmlActiveAttr} $matches} ret]} {
  472.                 set ret ""
  473.             }
  474.             if {[string length $ret]} {
  475.                 set htmlActiveInput $ret
  476.                 error "Continue!"
  477.             }
  478.             set htmlAttrTabSeen 0
  479.         } else {
  480.             set htmlAttrTabSeen 1
  481.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  482.         }
  483.         if {($htmlActiveUsed != "LI IN OL" &&  $htmlActiveUsed != "OL") ¥
  484.         || $attr != "TYPE="} { 
  485.             # special case 
  486.             set ret [htmlSetCase $ret] 
  487.         }
  488.         return $ret
  489.     }
  490.     return
  491. }
  492.  
  493. # ask for an attribute which is a number. Returns "" if input is not valid.
  494. proc htmlAskNumber {item attr required} {
  495.     global HTMLmodeVars 
  496.     
  497.     set promptNoisily    $HTMLmodeVars(promptNoisily)
  498.     
  499.     # loop until input is valid, then something is returned
  500.     while {1} { 
  501.         if {$promptNoisily} {beep}
  502.         set pr ""
  503.         if {!$required} { set pr "(optional) "}
  504.         # these two are special
  505.         if {$item == "LI IN UL" || $item == "LI IN OL"} { 
  506.             append pr LI:$attr
  507.         } else {
  508.             append pr ${item}:$attr
  509.         }
  510.         while {[catch {statusPrompt $pr htmlNumberStatusFunc} r]} { 
  511.             if {$r == "Cancel all!"} {
  512.                 message "Cancel"
  513.                 error
  514.             } 
  515.         }
  516.         
  517.         set r [string trim $r]
  518.         # if no input, just return
  519.         if {![string length $r]} { return}
  520.         # check that input is valid.
  521.         set numcheck [htmlCheckAttrNumber $item $attr $r]
  522.         if {$numcheck == 1} {
  523.             return $r 
  524.         } else {
  525.             alertnote "Invalid input. $numcheck"
  526.         }
  527.     }
  528. }
  529.  
  530. proc htmlNumberStatusFunc {curr c} {
  531.  
  532.     if {$c == "¥032"} {error "Cancel all!"}
  533.     if {[lsearch -exact {+ - 0 1 2 3 4 5 6 7 8 9 %} $c] >=0 } {
  534.         return $c
  535.     } else {
  536.         beep
  537.     }
  538. }
  539.  
  540. # Force yes or no in the status window
  541. proc htmlStatusAskYesOrNo {curr c} {
  542.     if {$c == "¥032"} {error "Cancel all!"}
  543.     set c [string tolower $c]
  544.     if {[string length $curr] == 0} {
  545.         if {$c == "n"} {return "no"}
  546.         if {$c == "y"} {return "yes"}
  547.         beep
  548.         return
  549.     }
  550.     beep
  551.     return
  552. }
  553.  
  554. # From menu, customize list of attributes which get asked about
  555. proc htmlUseAttrs {item} {
  556.     global HTMLmodeVars htmlPackageToUse modifiedVars
  557.     global htmlElemAttrUsed htmlElemAttrUsed3
  558.     global htmlElemAttrMore htmlElemAttrMore3
  559.     
  560.     set reqattrs [htmlGetRequired $item]
  561.     set used [htmlGetUsed $item]
  562.     set askformore [htmlGetAttrMore $item]
  563.     set optatts [htmlGetOptional $item]
  564.     set attrnumber [llength $optatts]
  565.     
  566.     set height [expr 95 + (( $attrnumber - 1) / 3 + 1) * 20]
  567.     set box "-w 400 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] ¥
  568.         -b Cancel 110 [expr $height - 30] 175 [expr $height - 10] ¥
  569.         -t {Select the optional attributes you want for $item} 10 10 450 30 "
  570.  
  571.     lappend box -t {Ask for more?} 10 [expr $height - 55] 110 [expr $height - 40] ¥
  572.         -r Yes $askformore 120 [expr $height - 55] 160 [expr $height - 40] ¥
  573.         -r No [expr !$askformore] 180 [expr $height - 55] 220 [expr $height - 40]
  574.     # see which attributes were used previously
  575.     set wpos 10 
  576.     set hpos 35
  577.     foreach attr $optatts {
  578.         if {[lsearch -exact $used $attr] >= 0} {
  579.             set checked 1
  580.         } else {
  581.             set checked 0
  582.         }
  583.         lappend box -c [string trimright $attr =] $checked $wpos $hpos [expr $wpos + 120] [expr $hpos + 15]
  584.         set wpos [expr $wpos + 130]
  585.             if {$wpos > 310} {
  586.                 set wpos 10
  587.                 set hpos [expr $hpos + 20]
  588.         }
  589.     }
  590.     # get the new ones wanted
  591.     set newatts [eval [concat dialog $box]]
  592.     set newuse {}
  593.     if {[lindex $newatts 0]} {
  594.         for {set i 0} {$i < $attrnumber} {incr i} {
  595.         if {[lindex $newatts [expr $i + 4]]} {
  596.                 lappend newuse [lindex $optatts $i]
  597.             }
  598.         }
  599.         set newuse [concat $reqattrs $newuse]
  600.         if {$htmlPackageToUse == 1} {
  601.             set num ""
  602.         } else {
  603.             set num 3
  604.         }
  605.         set htmlElemAttrUsed${num}($item) $newuse
  606.         addArrDef htmlElemAttrUsed$num $item $newuse
  607.         set htmlElemAttrMore${num}($item) [lindex $newatts 2]
  608.         addArrDef htmlElemAttrMore$num $item [lindex $newatts 2]
  609.     }
  610. }
  611.  
  612.